#! /usr/bin/env perl

# Note: Using the following 'fool proof' method of starting Perl will
# cause problems unless HPCTOOLKIT stuff has been added to the shell
# initialization file.  The exec will start a new shell and 'hpqquick' will
# not be found unless shell's initialization file sets the PATH.  This
# is probably not what we want.

#eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
#& eval 'exec perl -S $0 $argv:q'
#if 0;

## $Id$
## * BeginRiceCopyright *****************************************************
## 
## Copyright ((c)) 2002-2019, Rice University 
## All rights reserved.
## 
## Redistribution and use in source and binary forms, with or without
## modification, are permitted provided that the following conditions are
## met:
## 
## * Redistributions of source code must retain the above copyright
##   notice, this list of conditions and the following disclaimer.
## 
## * Redistributions in binary form must reproduce the above copyright
##   notice, this list of conditions and the following disclaimer in the
##   documentation and/or other materials provided with the distribution.
## 
## * Neither the name of Rice University (RICE) nor the names of its
##   contributors may be used to endorse or promote products derived from
##   this software without specific prior written permission.
## 
## This software is provided by RICE and contributors "as is" and any
## express or implied warranties, including, but not limited to, the
## implied warranties of merchantability and fitness for a particular
## purpose are disclaimed. In no event shall RICE or contributors be
## liable for any direct, indirect, incidental, special, exemplary, or
## consequential damages (including, but not limited to, procurement of
## substitute goods or services; loss of use, data, or profits; or
## business interruption) however caused and on any theory of liability,
## whether in contract, strict liability, or tort (including negligence
## or otherwise) arising in any way out of the use of this software, even
## if advised of the possibility of such damage. 
## 
## ******************************************************* EndRiceCopyright *

#############################################################################
#
# $Source$ 
#
# R. Fowler    2000.07: Initial version
# N. Tallent   2004.09: Major revision
#
# A Perl script to help users get started quickly with HPCToolkit.
# This script processes various profile data files, creates a simple
# hpcview configuration file and runs 'hpcview' using that
# configuration.
# 
#############################################################################

use strict;
use warnings;

use IO::File;
use IO::Pipe;
use FindBin qw($Script $RealBin);

use lib "$RealBin/../share/hpctoolkit";
use HPCToolkitVersionInfo;

STDOUT->autoflush(1); 

#print STDOUT "path $ENV{PATH} \n";

#############################################################################

my $the_program = $Script;
my $the_usage = 
"Usage: 
  ${the_program} [other-options] [-I <path>] [-S <struct-file>] [-G <group-file>] -P <profile-file>...

hpcquick is a front-end for hpcview.  It creates an hpcview configuration file
(./hpcquick.xml) and runs hpcview to create an Experiment database.  All shell
commands used to create the Experiment database are recorded in a log file
(./hpcquick.log).

hpcquick expects a (space-separated) list of profile files, which may be of the following types:
  o binary output from hpcrun
  o binary output from SGI's ssrun
  o XML PROFILE files (e.g., from hpcprof and xprof)
For best results, two other options should be used: -I to provide paths for
source code directories and -S to provide source code structure from bloop.

Options: Correlation
  -I <path>           A path (relative or absolute) containing source code to
                      which performance data should be correlated.  In order to
                      search a directory *and* recursively search all of its
                      descendents, append an escaped '*' after the last slash,
                      e.g., /mypath/\\* (escaping is for the shell).
                      May be passed multiple times.
  -S <struct-file>    A structure file (from bloop) for the main program
		      and/or any or all of the shared libraries used by the
                      program.  May be passed multiple times.

Options: General
  -n                  No hpcview output.  Convert profiles and create an 
                      hpcview config file, but do not generate an hpcview
                      output database.
  -V                  Print version information.
  -h                  Print this help.
";

# Group file stuff is probably deprecated...
#  -G <group-file>     A group file for the main program and/or any or all
#                      of the shared libraries used by the program. 
#                      May be passed multiple times.

# Does not currently support
#   o [binary output from Alpha-Tru64's uprofile] 

# Note: All option flags should be known by isArgument().
my $helpOpt         = '-h';
my $verOpt          = '-V';
my $noOutOpt        = '-n';
my $incOpt          = '-I';
my $structOpt       = '-S';
my $groupOpt        = '-G';
my $profOpt         = '-P';

#############################################################################

# A generic container for 'names'.  Warning: these fields sometimes
# have slightly different semantics.
my %names_t = 
    (
     hashTable  => undef, # hash of names to their index within the list
     list       => undef, # array of names
     totals     => undef, # num of dup. of each item in 'names'
     total      => 0,     # number of names contained within
     
     indices    => undef, # Used to generate unique names in config files
     );

# metricInfo_t: a 'struct' representing hpcview metric information
# Warning: the first two fields are abused (FIXME)
my %metricInfo_t = 
    (
     type         => undef, # index into hpcviewConfigData{metricTypes}
     dispNm       => undef, # index into hpcviewConfigData{metricDispNms}
     profinfo     => undef, # a 'profileInfo_t'
     canonMId   => undef, # id of the metric within the canonical file
     );

# profileInfo_t: a 'struct' of PROFILE data and its corresponding raw
# profile data.
#   Note: In theory a metric may be defined with multiple raw profile
#   files, but we currently do not support this.  In this case, all
#   the profile data would be incorporated into one metric in a
#   PROFILE file.  *** To reiterate: Currently, there will be one
#   metric per raw profile file. ***
my %profileInfo_t = 
    (
     canonFile => undef, # canonical profile file
     canonType => undef, # hpcrun or PROFILE (less info)
     rawProfFiles => undef, # list of any corresponding raw profile files
     rawProfType  => undef, # type of raw data (if applicable)
     );

#############################################################################

my ($hpcrunType,
    $ssrunType,
    $uprofileType,
    $PROFILEType) =
    (0, 1, 2, 3);

my $hpcrunIdSuffix = '[hpcrun]';

my $pxmlExt        = '.pxml';
my $xmlAttrRE      = '\s*=\s*\"([^\"]+)\"'; # grabs everything between ""

############################################################################
## main/driver
#############################################################################

# fields of the configuration structure (corresponding to the HPCView
# XML configuraiton file) 

my %hpcviewConfigData = 
    (
     title            => undef, # title of profile database
     srcPaths         => undef, # 'names_t', list of unique src paths
     structFiles      => undef, # 'names_t', list of unique struct files
     groupFiles       => undef, # 'names_t', list of unique group files
     metricTypes      => undef, # 'names_t', hash of metric types
     metricDispNms    => undef, # 'names_t', hash of metric names
     metrics          => [ ],   # array of 'metricInfo_t'
     dumpFlag         => undef,  
     );
my $opt_srcPaths = [ ];
my $opt_structFiles = [];
my $opt_groupFiles = [];
my $opt_profileFiles = [ ];
my $opt_suppressOutput = 0;
my $opt_outputDB   = "experiment-db";

my $configFile = "hpcquick.xml";
my $logFile = "hpcquick.log";

# ----------------------------------------------------------
# process the command line arguments
# ----------------------------------------------------------
parseOptions($0);

# ----------------------------------------------------------
# Create and fill 'hpcviewConfigData' data structure
# ----------------------------------------------------------

# Easy initialization
Config_init(\%hpcviewConfigData);
Config_addSrcPaths(\%hpcviewConfigData, $opt_srcPaths);
Config_addStructFiles(\%hpcviewConfigData, $opt_structFiles);
Config_addGroupFiles(\%hpcviewConfigData, $opt_groupFiles);

my $logFHndl = new IO::File();
$logFHndl->open("> $logFile")
    or Error("Can't open '$logFile'\n");

# Canonicalize profile data into PROFILE data
print STDOUT "* Canonicalizing performance data...\n";
my $isHpcrunCanonical = (scalar(@{$opt_structFiles}) > 0);
if (!$isHpcrunCanonical) {
  print STDOUT "  WARNING: No STRUCTURE files found! HPCRUN profile files will be converted for line-level correlation only (rather than by address)!\n";
}
my $profileData = canonicalizeProfileData($opt_profileFiles, $logFHndl,
                                          $isHpcrunCanonical);

# Initialize metrics using PROFILE files
print STDOUT "* Collecting metrics from performance data...\n";
Config_addMetrics(\%hpcviewConfigData, $profileData);
if (scalar(@{$hpcviewConfigData{metrics}}) == 0) {
  Error("No valid metrics found within profile data.\n");
}

Config_addTitle(\%hpcviewConfigData);

# ----------------------------------------------------------
# Generate hpcview information
# ----------------------------------------------------------

# Generate hpcview config file
print STDOUT "* Generating hpcview configuration file...\n";
genHPCViewConfigFile(\%hpcviewConfigData, $configFile, $logFHndl);

# Generate hpcview database (if necessary)
if (!($opt_suppressOutput)) {
  print STDOUT "* Running hpcview to create browsable database...\n";
} 
else {
  print STDOUT "* Sending command to create browsable database to log...\n";
}
my $db = genHPCViewDB(\%hpcviewConfigData, $configFile, $logFHndl);

$logFHndl->close();

# Final notice
print STDOUT "\n";
print STDOUT "* Created files: '$configFile', '$logFile'\n";
if (!($opt_suppressOutput)) {
  print STDOUT "* Browsable database: '$db'\n";
}

exit(0);


#############################################################################
##
#############################################################################

# parseOptions: 
sub parseOptions
{  
  my ($command) = @_; 
  
  my $argc = scalar(@ARGV);  
  if ($argc < 1) {
    UsageError("Missing a required argument!\n");
  }
  
  my $i = 0;
  while ($i < $argc) {

    # option: help
    if ($ARGV[$i] eq $helpOpt) {
      printUsageAndExit($command);
    }

    # option: version
    if ($ARGV[$i] eq $verOpt) {
      printVersionAndExit($command);
    }

    # option: output style
    if ($ARGV[$i] eq $noOutOpt) {
      $opt_suppressOutput = 1;
    }

    # option: program structure
    elsif ($ARGV[$i] eq $structOpt) {
      while (isArgument($ARGV[$i + 1]) == 1) {
        $i++;
        push(@{$opt_structFiles}, $ARGV[$i]);
      }
    }

    # option: groups
    elsif ($ARGV[$i] eq $groupOpt) {
      while (isArgument($ARGV[$i + 1]) == 1) {
        $i++;
        push(@{$opt_groupFiles}, $ARGV[$i]);
      }
    }

    # option: include src paths
    elsif ($ARGV[$i] eq $incOpt) {
      while (isArgument($ARGV[$i + 1]) == 1) {
	$i++;
	push(@{$opt_srcPaths}, $ARGV[$i]);
      }
    }

    # profile files
    elsif ($ARGV[$i] eq $profOpt) {
      while (isArgument($ARGV[$i + 1]) == 1) {
	$i++;
	push(@{$opt_profileFiles}, $ARGV[$i]);
      }
    }

    # something not recognized
    else {
      UsageError("Invalid argument: '$ARGV[$i]'\n");
    }
    
    # point to the next argument
    $i++;
  }
  
  
  # ----------------------------------------------------------
  # semantic checks
  # ----------------------------------------------------------
  if (!defined($configFile)) {
    Error("Internal Error: Missing config file name\n");
  }   
}


# isArgument
#   find out whether the word is an argument or option flag or undefined
#   return 0 if it is not defined
#   return 1 if it is an argument
#   return 2 if it is not an argument (i.e. an option flag)
sub isArgument 
{
  my $arg = shift;
  if (!defined($arg)) {
    return 0;
  }
  if ($arg eq $helpOpt || $arg eq $verOpt
      || $arg eq $noOutOpt 
      || $arg eq $incOpt || $arg eq $structOpt || $arg eq $groupOpt 
      || $arg eq $profOpt) {
    return 2;
  }
  return 1;
}


# printUsageAndExit
sub printUsageAndExit 
{
  my ($command) = @_; # not used now
  print STDOUT $the_usage;
  exit(-1);
}


# printVersionAndExit
sub printVersionAndExit 
{
  my $command = shift; # not used now
  print STDERR "${the_program}: ", $HPCToolkitVersionInfo::info, "\n";
  exit(-1);
}


# UsageError
sub UsageError 
{
  my ($msg) = @_;
  if (defined($msg)) {
    print STDOUT "${the_program}: ${msg}";
  }
  print STDOUT "Try `${the_program} -h' for more information.\n";
  exit(-1);
}


# Error
sub Error 
{
  my ($msg) = @_;
  if (defined($msg)) {
    print STDOUT "Error! ${the_program}: ${msg}";
  }
  exit(-1);
}


#############################################################################
## 
#############################################################################

# Config_init: 
sub Config_init
{  
  my ($cfgData) = @_;
  
  # contains included source paths
  $cfgData->{srcPaths} = { %names_t, };
  $cfgData->{srcPaths}->{hashTable} = { };
  $cfgData->{srcPaths}->{list} = [ ];
  $cfgData->{srcPaths}->{totals} = [ ];
  $cfgData->{srcPaths}->{indices} = [ ];

  # contains included source paths
  $cfgData->{structFiles} = { %names_t, };
  $cfgData->{structFiles}->{hashTable} = { };
  $cfgData->{structFiles}->{list} = [ ];
  $cfgData->{structFiles}->{totals} = [ ];
  $cfgData->{structFiles}->{indices} = [ ];

  # contains included source paths
  $cfgData->{groupFiles} = { %names_t, };
  $cfgData->{groupFiles}->{hashTable} = { };
  $cfgData->{groupFiles}->{list} = [ ];
  $cfgData->{groupFiles}->{totals} = [ ];
  $cfgData->{groupFiles}->{indices} = [ ];

  # includes all different metric types
  $cfgData->{metricTypes} = { %names_t, };
  $cfgData->{metricTypes}->{hashTable} = { };
  $cfgData->{metricTypes}->{list} = [ ];
  $cfgData->{metricTypes}->{totals} = [ ];
  $cfgData->{metricTypes}->{indices} = [ ];
  
  # includes all different metric display names
  $cfgData->{metricDispNms} = { %names_t, };
  $cfgData->{metricDispNms}->{hashTable} = { };
  $cfgData->{metricDispNms}->{list} = [ ];
  $cfgData->{metricDispNms}->{totals} = [ ];
  $cfgData->{metricDispNms}->{indices} = [ ];
  
  # includes information for each metric
  $cfgData->{metrics} = [ ];
}


# Config_addSrcPaths
#   Given a ref to a hpcviewConfigData data structure and a list of source file
#   paths, perform sanity checks and store the paths within the structure.
sub Config_addSrcPaths
{
  my ($cfgData, $paths) = @_;

  for my $x (@{$paths}) {
    if (isValidSrcPath($x)) {
      Config_addToNamesList($cfgData->{srcPaths}, $x);
    }
    else {
      UsageError("Invalid argument to -I: '$x' not a directory.\n");
    }
  }
}


# Config_addStructFiles
#   Given a ref to a hpcviewConfigData data structure and a list of
#   structure file paths, perform sanity checks and store the paths
#   within the structure.
sub Config_addStructFiles
{
  my ($cfgData, $paths) = @_;

  for my $x (@{$paths}) {
    if (-e $x && -r $x) {
      Config_addToNamesList($cfgData->{structFiles}, $x);
    }
    else {
      UsageError("Invalid argument to -S: '$x' is not readable.\n");
    }
  }
}


# Config_addGroupFiles
#   Given a ref to a hpcviewConfigData data structure and a list of
#   group file paths, perform sanity checks and store the paths within
#   the structure.
sub Config_addGroupFiles
{
  my ($cfgData, $paths) = @_;

  for my $x (@{$paths}) {
    if (-e $x && -r $x) {
      Config_addToNamesList($cfgData->{groupFiles}, $x);
    }
    else {
      UsageError("Invalid argument to -G: '$x' is not readable.\n");
    }
  }
}


# Config_addToNamesList
#   Given a 'names_t' add 'nm' to the hashTable and list, if it will
#   not create duplicates.
#   Returns 1 for a valid path added to config;
#           0 for a path already existing in config.
sub Config_addToNamesList
{
  my ($anames, $nm) = @_;
  
  if (!defined($anames->{hashTable}->{$nm})) {
    $anames->{hashTable}->{$nm} = 0;
    push(@{$anames->{list}}, $nm);
    $anames->{total}++;
    return 1;
  }
  else {
    return 0;
  }
}


# Config_addMetrics: 
#   Given a ref to a hpcviewConfigData data structure and a list of
#   'profileInfo_t', initialize metrics based on the canonical PROFILE
#   info.
sub Config_addMetrics 
{
  my ($cfgData, $profData) = @_;
  
  for my $x (@{$profData}) {
    Config_addMetric($cfgData, $x);
  }
}


# Config_addMetric
#   Given a ref to a hpcviewConfigData data structure and a
#   'profileInfo_t', gather metrics from the PROFILE information.
#   (Since a PROFILE file may have multiple metrics, several metrics
#   can refer to the same PROFILE file.)
sub Config_addMetric
{
  my ($cfgData, $aprofInfo) = @_;

  my $fnm = $aprofInfo->{canonFile};  
  my $ty  = $aprofInfo->{canonType};  

  # Find a list of metrics within the profile.  Note that the returned
  # list is not in the proper format.
  my $metricsRef = ($ty == $hpcrunType) ? 
		    findMetricsForHPCRUN($fnm) : findMetricsForPROFILE($fnm);
  my $numMetrics = scalar(@{$metricsRef});
  if ($numMetrics == 0) {
    print STDOUT "Warning: Could not find any metrics in '$fnm'\n";
  }
  
  # Create a proper metric list containing each metric from this profile file
  for (my $i = 0; $i < $numMetrics; $i++) {    
    my $aMetric = { %metricInfo_t, };
    my $mType = $metricsRef->[$i]->{type};
    my $mDispNm = $metricsRef->[$i]->{dispNm};
    #print STDOUT "mType = $mType\n";
    #print STDOUT "dispname = $mDispNm\n";
    
    # sets aMetric->type, dispNm (as indices!)
    Config_addMetricNames($cfgData, $aMetric, $mType, $mDispNm);
    
    # set aMetric->profinfo, canonMId
    $aMetric->{profinfo} = $aprofInfo;
    $aMetric->{canonMId} = $metricsRef->[$i]->{canonMId};

    # Add this metric to the list
    push(@{$cfgData->{metrics}}, $aMetric);
  }
}


# Config_addMetricNames
#   Given a ref to a hpcviewConfigData data structure and a metricInfo_t,
#   test whether the metric type and display name exist.
#     if yes, increase its number
#     if not, insert the new name into the array and hash table
sub Config_addMetricNames
{
  my ($cfgData, $aMetric, $mType, $mName) = @_;
  #print STDOUT "Config_addMetricNames:\n";
  #print STDOUT "  -", @{$cfgData->{metricTypes}->{totals}}, "\n";
  #print STDOUT "  -", @{$cfgData->{metricDispNms}->{totals}}, "\n";
  #print STDOUT "  $mType, $mName\n";
  
  my $mTypeIdx = $cfgData->{metricTypes}->{hashTable}->{$mType};
  my $mNameIdx = $cfgData->{metricDispNms}->{hashTable}->{$mName};
  
  if (!defined($mTypeIdx)) {
    $mTypeIdx = $cfgData->{metricTypes}->{total}++;
    $cfgData->{metricTypes}->{hashTable}->{$mType} = $mTypeIdx;
    push(@{$cfgData->{metricTypes}->{list}}, $mType);
    push(@{$cfgData->{metricTypes}->{totals}}, 1);
    push(@{$cfgData->{metricTypes}->{indices}}, 0);
  }
  else {
    $cfgData->{metricTypes}->{totals}->[$mTypeIdx]++;
  }
  if (!defined($mNameIdx)) {
    $mNameIdx = $cfgData->{metricDispNms}->{total}++;
    $cfgData->{metricDispNms}->{hashTable}{$mName} = $mNameIdx;
    push(@{$cfgData->{metricDispNms}->{list}}, $mName);
    push(@{$cfgData->{metricDispNms}->{totals}}, 1);
    push(@{$cfgData->{metricDispNms}->{indices}}, 0);
  }
  else {
    $cfgData->{metricDispNms}->{totals}->[$mNameIdx]++;
  }
  $aMetric->{type} = $mTypeIdx;
  $aMetric->{dispNm} = $mNameIdx;
  #print STDOUT "  -", @{$cfgData->{metricTypes}->{totals}}, "\n";
  #print STDOUT "  -", @{$cfgData->{metricDispNms}->{totals}}, "\n";
}


# Config_addTitle:
#   Given a ref to a hpcviewConfigData data structure that *already*
#   contains metrics, make up a title.
sub Config_addTitle
{
  my ($cfgData, $aprofInfo) = @_;

  # If no title exists, extract the title from the first PROFILE file
  if (!defined($cfgData->{title})) {
    my $fnm = $cfgData->{metrics}[0]->{profinfo}->{canonFile};
    $cfgData->{title} = Config_makeTitle($fnm);
  }
}


# Config_makeTitle
#   Given a PROFILE file, make up a title.
sub Config_makeTitle
{
  my ($profile) = @_;
  
  my $title = "(Untitled)";
  
  my $profileHandle = new IO::File();
  $profileHandle->open("< $profile")
      or Error("Can't open '$profile'\n");

  while (<$profileHandle>) {
    my $line = $_;
    if ($line =~ /<TARGET /) {
      ($title) = ($line =~ /name$xmlAttrRE/);
      last;
    }
  }
  $profileHandle->close();

  #print STDOUT "*** Title: $title\n";
  return $title;
}


#############################################################################
##
#############################################################################

# genHPCViewConfigFile
#   Given a hpcviewConfigData data structure, generate a hpcview
#   config file.  Any system commands are also written to $logFHndl.
sub genHPCViewConfigFile 
{
  my ($cfgData, $cfgFnm, $logFhndl) = @_;
  
  my $cfgFhndl = new IO::File();  
  $cfgFhndl->open("> $cfgFnm")
      or Error("Can't open '$cfgFnm'\n");
  
  # start document tag
  print {$cfgFhndl} "<HPCVIEW>\n\n";
  
  # title
  print {$cfgFhndl} "<TITLE name=\"", xmlEsc($cfgData->{title}), "\"/>\n\n";

  # ------------------------------------------------------
  # src paths
  # ------------------------------------------------------
  for (my $i = 0; $i < $cfgData->{srcPaths}->{total}; $i++) {
    my $dir = $cfgData->{srcPaths}->{list}[$i];
    my $viewnm = getViewnameFromSrcPath($dir);
    
    print STDOUT "  Adding source path: '$dir'\n";
    print {$cfgFhndl} "<PATH name=\"", xmlEsc($dir), "\" ",
          "viewname=\"", xmlEsc($viewnm), "\"/>\n";
  }
  print {$cfgFhndl} "\n";
  
  # ------------------------------------------------------
  # structure file
  # ------------------------------------------------------
  for (my $i = 0; $i < $cfgData->{structFiles}->{total}; $i++) {
    my $fnm = $cfgData->{structFiles}->{list}[$i];
    
    print STDOUT "  Adding structure file: '$fnm'\n";
    print {$cfgFhndl} "<STRUCTURE name=\"", xmlEsc($fnm), "\"/>";
    print {$cfgFhndl} "\n\n";
  }

  # ------------------------------------------------------
  # group file
  # ------------------------------------------------------
  for (my $i = 0; $i < $cfgData->{groupFiles}->{total}; $i++) {
    my $fnm = $cfgData->{groupFiles}->{list}[$i];
    
    print STDOUT "  Adding group file: '$fnm'\n";
    print {$cfgFhndl} "<GROUP name=\"", xmlEsc($fnm), "\"/>";
    print {$cfgFhndl} "\n\n";
  }
  
  # ------------------------------------------------------
  # metrics
  # ------------------------------------------------------
  
  my $numMetrics = scalar(@{$cfgData->{metrics}});  
  
  # Create metric display names
  # FIXME: This abuses the data structure semantics and is out-of-place
  for (my $i = 0; $i < $numMetrics; $i++) {
    my $metric = $cfgData->{metrics}[$i];
    
    # both name and display name are defined according to whether
    # there are multiple instances of them.  If there are,
    # distingish by appending a cardinal number
    my $mType = $metric->{type};
    my $mTypeQ = $cfgData->{metricTypes}->{list}[$mType];
    if ($cfgData->{metricTypes}->{totals}[$mType] > 1) {
      $mTypeQ .= "-" . $cfgData->{metricTypes}->{indices}[$mType]++;
    }
    
    my $dispNm = $metric->{dispNm};
    my $dispNmQ = $cfgData->{metricDispNms}->{list}[$dispNm];
    if ($cfgData->{metricDispNms}->{totals}[$dispNm] > 1) {
      $dispNmQ .= "-" . $cfgData->{metricDispNms}->{indices}[$dispNm]++;
    }
    
    #print STDOUT "mTypeQ = $mTypeQ\n";
    #print STDOUT "dispNmQ = $dispNmQ\n";
    $metric->{type} = $mTypeQ;    # save for later (Abuse!)
    $metric->{dispNm} = $dispNmQ; # save for later (Abuse!)

  }
  
  for (my $i = 0; $i < $numMetrics; $i++) {
    my $metric = $cfgData->{metrics}[$i];
    
    my $nm = $metric->{dispNm};
    my $fnm = $metric->{profinfo}->{canonFile};
    my $fty = $metric->{profinfo}->{canonType};
    
    print STDOUT "  Adding metric '$nm' from '$fnm'\n";
    
    # METRIC start tag
    print {$cfgFhndl} "<METRIC name=\"", xmlEsc($metric->{type}), "\" ",
          "displayName=\"", xmlEsc($nm), "\"";
    
    if ($i == 0) { print {$cfgFhndl} " sortBy=\"true\""; }
    print {$cfgFhndl} ">\n";
    
    # FILE subelement
    my $FILEty = ($fty == $hpcrunType) ? 'HPCRUN' : 'PROFILE';
    print {$cfgFhndl} "  <FILE name=\"", xmlEsc($fnm), "\" ",
	  "select=\"", xmlEsc($metric->{canonMId}), "\" ",
          "type=\"${FILEty}\"/>\n";
  
    # METRIC end tag
    print {$cfgFhndl} "</METRIC>\n\n";
  }
  
  # end document tag
  print {$cfgFhndl} "</HPCVIEW>\n";
  
  $cfgFhndl->close();
}  


# genHPCViewDB
#   Given a hpcviewConfigData data structure and config file, generate
#   a hpcview database and return its name.  Any system commands are
#   also written to $logFHndl.
sub genHPCViewDB 
{
  my ($cfgData, $cfgFnm, $logFhndl) = @_;

  # Create a database name
  my $outputdb = $opt_outputDB;
  if (-d $outputdb || -e $outputdb) {
    print STDOUT "  Warning: database directory '$outputdb' exists; creating unique name.\n";
    $outputdb .= "-" . $$; # append pid (if this exists, too bad)
  }
  
  # run hpcview
  my $cmd = "${RealBin}/hpcprof-flat -o $outputdb $cfgFnm";
  print STDOUT "  $cmd\n";
  print {$logFhndl} "$cmd\n";
  
  if (!($opt_suppressOutput)) {
    print STDOUT "---------------------------------------------------------\n";
    if (system($cmd) != 0) {
      Error("system() failed! '$cmd'\n");
    }
    print STDOUT "---------------------------------------------------------\n";
  }
  
  return $outputdb;  
}
    

#############################################################################

# isValidSrcPath
#   Given a path to be used in a PATH element, test whether it is valid.
#   Returns 1 or 0.
sub isValidSrcPath 
{
  my ($path) = @_;
  
  # Remove recursive path indicator, if present.
  my $p = isRecursivePath($path);
  if ($p) { $path = $p; }
  
  if (-d $path && -e $path) {
    return 1;
  } else {
    return 0;
  }
}


# getViewnameFromSrcPath
#   Given a source path, return a viewname. (for PATH element).  The
#   viewname should not be empty.
{
  my $defaultViewNm;
  my $defaultQualifier;
  
  sub getViewnameFromSrcPath 
  {
    my ($path) = @_;
    my $recursive = 0;
    
    # ------------------------------------------------------
    # Normalize path into initial viewname.  If we have a path like
    # the following, we would like to use its name:
    #   ./mypath, ./mypath/*, mypath/, ./mypath/.
    # Admittedly, this is not overly likely.
    # ------------------------------------------------------
    
    # Remove recursive path indicator, if present.
    my $p = isRecursivePath($path);
    if ($p) {
      $path = $p;
      $recursive = 1;
    }
    
    # Remove any beginning '.' (but not ..!)
    $path =~ s/^\.$//;  # .
    $path =~ s/^\.\///; # ./
    
    # Remove any trailing '/' or '/.'
    $path =~ s/\/$//; 
    $path =~ s/\/\.$//; 
    
    my $viewnm = $path;
    
    # ------------------------------------------------------
    # Now, if viewname contains invalid chars, canonicalize.
    # Invalid: ., *, ?, /, \  (there are others...)
    # ------------------------------------------------------
    
    if ( $viewnm eq "" 
	 || ($viewnm =~ /\./) || ($viewnm =~ /\*/) 
	 || ($viewnm =~ /\?/) 
	 || ($viewnm =~ /\//) || ($viewnm =~ /\\/)) {
      $viewnm = $defaultViewNm . $defaultQualifier;
      $defaultQualifier++;
    }
    
    return $viewnm;
  }

  BEGIN { 
    $defaultViewNm = "src";
    $defaultQualifier = 1;
  }
}


# isRecursivePath
#   Given a source path, return the non-recursive name if this is a
#   recursive path, otherwise return undef.
sub isRecursivePath 
{
  my ($path) = @_;
  
  # This is a recursive path if it ends with '/*'.  If it
  # exists, strip it off.
  my $cnt = ($path =~ s/\/\*$//);
  
  if ($cnt > 0) {
    return $path;
  } else {
    return undef;
  }
}


# canonicalizeProfileData
#   Given a list of profile data files and a file handle to a log
#   file, creates a canonical data file for all raw profile files
#   (ssrun, umon.out, etc.)  Saves canonicalizing commands to the log
#   file.
#    - hpcrun files are canonical
#    - For non-hpcrun files:
#      - Convert binary profiles into PROFILE data (stored in a
#        temporary filename since we don't know how to extract metric
#        names). (Eventually we may support converting a group of binary
#        data into one PROFILE data file.)
#      - Associates raw profile files with PROFILE file (for later use).
#    - Returns a list of 'profileInfo_t'
sub canonicalizeProfileData
{
  my ($profFiles, $logFhndl, $isHpcrunCanonical) = @_;
    
  my $profileData = [ ];

  for my $x (@{$profFiles}) {
    # test whether the file exists
    if ( !(-e $x && -r $x) ) {
      UsageError("Invalid or non-existent profile file: '$x'\n");
    }
    # test that the file has non-zero size (it is difficult to
    # determine the file type of empty files)
    if ( -z $x ) {
      UsageError("Zero-sized profile file: '$x'\n");
    }
    
    # if we do not have a PROFILE or hpcrun file, canonicalize
    my ($canonFile, $canonType) = (undef, undef);
    my $rawFile = $x;
    my $rawTy = getProfileType($rawFile);

    print STDOUT "  ${x} of type ${rawTy}\n";

    if (($rawTy == $hpcrunType && $isHpcrunCanonical) 
	|| $rawTy == $PROFILEType) {
      $canonFile = $rawFile;
      $canonType = $rawTy;
    }
    else {
      $canonFile = canonicalizeProfileToPROFILE($rawFile, $rawTy, $logFhndl);
      $canonType = $PROFILEType;
    }
    
    my $aProfInfo = { %profileInfo_t, };
    $aProfInfo->{canonFile} = $canonFile;
    $aProfInfo->{canonType} = $canonType;
    $aProfInfo->{rawProfFiles} = [ ];
    push(@{$aProfInfo->{rawProfFiles}}, $rawFile);
    $aProfInfo->{rawProfType} = $rawTy;
    
    push(@{$profileData}, $aProfInfo);
  }

  return $profileData;
}


# canonicalizeProfileToPROFILE
#   Given a raw profile file and its type, canonicalize into a PROFILE
#   file and return the new file name.
{
  my ($sgiProfCmd, $alphaProfCmd, $ptranCmd);
  my $hpcprofCmd;

  sub canonicalizeProfileToPROFILE
  {
    my ($rawFile, $profTy, $logFhndl) = @_;

    # Determine what command should be used to generate PROFILE data
    my $PROFILEFile = $rawFile . ".hpcquick" . $pxmlExt;
    my $rawFileNms = $rawFile; # could potentially be a list

    my $cmd = undef;
    
    if ($profTy == $hpcrunType) {
      # grab the <exe> portion of the first file name; it is only used to
      # create a title (using the non-greedy version of * = *?)
      my ($exe) = ($rawFileNms =~ m/^(.*?)\./);
      $cmd = "$hpcprofCmd $exe $rawFileNms > $PROFILEFile";
    }
    elsif ($profTy == $ssrunType) {
      $cmd = "$sgiProfCmd $rawFileNms | $ptranCmd > $PROFILEFile";
    }
    elsif ($profTy == $uprofileType) {
      my $exe = 'foo'; # FIXME
      $cmd = "$alphaProfCmd $exe $rawFileNms | $ptranCmd > $PROFILEFile";
    }
    else {
      print STDERR "Internal Error: Unknown profile type '$profTy'\n";
    }

    # Execute the command
    print STDOUT "  $cmd\n";
    print {$logFhndl} "$cmd\n";
    if (system($cmd) != 0) {
      Error("system() failed! '$cmd'\n");
    }
    
    return $PROFILEFile;
  }

  BEGIN { 
    $sgiProfCmd = "prof -lines";
    $alphaProfCmd = "prof -lines";
    $hpcprofCmd = "${RealBin}/hpcproftt -p";
    $ptranCmd = "ptran";
  }
}


# findMetricsForPROFILE
#   Given a PROFILE file, return an array ref of 'metricInfo_t' for the
#   file. Assume the file exists.
#   
#   Note: The 'type' and 'dispNm' fields of 'metricInfo_t' contain
#   *strings* not indices (IOW, it is doing double-duty.)
sub findMetricsForPROFILE 
{
  my ($proffile) = @_;
  
  my $metrics = [ ];
  
  my $profileHandle = new IO::File();
  $profileHandle->open("< $proffile")
      or Error("Can't open '$proffile'\n");

  my $i = 0;
  while (<$profileHandle>) {
    my $line = $_;
    
    if ($line =~ /<METRIC /) {
      my $aMetric = { %metricInfo_t, };
      
      my ($nm) = ($line =~ /displayName$xmlAttrRE/);
      my ($id) = ($line =~ /shortName$xmlAttrRE/);
      
      $aMetric->{type} = $nm;
      $aMetric->{dispNm} = $nm;
      $aMetric->{canonMId} = $id;
      $metrics->[$i] = $aMetric;
      $i++;
    }
    if ($line =~ /<\/METRICS>/) {
      last;
    }
  }
  $profileHandle->close();
  
  return $metrics;
}


# findMetricsForHPCRUN
#   Given a HPCRUN file, return an array ref of 'metricInfo_t' for the
#   file. Assume the file exists.
#   
#   Note: The 'type' and 'dispNm' fields of 'metricInfo_t' contain
#   *strings* not indices (IOW, it is doing double-duty.)
sub findMetricsForHPCRUN 
{
  my ($proffile) = @_;
  
  my $hpcprofEventRE = '(\w+):\d+ - .*';
  my $hpcprofCmd = "${RealBin}/hpcproftt foo $proffile";

  my $metrics = [ ];
  

  my $pipe = new IO::Pipe;
  $pipe->reader($hpcprofCmd)
      or Error("Can't open '$proffile'\n");

  my $i = 0;
  while (<$pipe>) {
    my $line = $_;
    
    if ($line =~ /^Columns correspond to the following events/) {
      next; # first line
    }
    else {
      my $aMetric = { %metricInfo_t, };
      
      my ($nm) = ($line =~ /$hpcprofEventRE/);
      my ($id) = $i;
      
      $aMetric->{type} = $nm;
      $aMetric->{dispNm} = $nm;
      $aMetric->{canonMId} = $id;
      $metrics->[$i] = $aMetric;
      $i++;
    }
  }

  return $metrics;
}


# getProfileType
#   Given a profile file, returns one of 'ssrunType', 'uprofileType',
#   'PROFILEType'
{
  my $PROFILEFileRE;
  my $ssrunFileRE;
  my $uprofFileRE;

  sub getProfileType 
  {
    my ($profile) = @_;

    # Open and examine header
    my $header = "";
    my $profileHandle = new IO::File();
    $profileHandle->open("< $profile")
	or Error("Can't open '$profile'\n");
    
    # 1. Test for a magic string at the beginning of the file
    seek($profileHandle, 0, 0); # rewind to beginning
    my $sz = 16;
    my $ret = read($profileHandle, $header, $sz);
    if ($ret == $sz) {
      if ($header =~ /^HPCRUN/s) {
	return $hpcrunType;
      }
    }
    
    # 2. Read a chunk of the file and examine the header information
    seek($profileHandle, 0, 0); # rewind to beginning
    $sz = 256; 
    $ret = read($profileHandle, $header, $sz);
    if ($ret == $sz) {
      if ($header =~ /<!DOCTYPE PROFILE /s) {
	return $PROFILEType;
      }
    }

    $profileHandle->close();

    # 3. Guess, based on file name
    if ($profile =~ /$ssrunFileRE/) {
      return $ssrunType;
    } 
    else {
      return $uprofileType;
    }
  }

  BEGIN { 
    $PROFILEFileRE = '.+\.pxml';
    #$hpcrunFileRE = '(.*)\.(.*)\.(.*)'; # <exe>.<event>.<host>.<pid>
    $ssrunFileRE   = '(.*)\.(\w+)\.([fm]\d+)';
    $uprofFileRE   = undef; # 'umon.out'
  }
}


# xmlEsc($content)
#   return a string with <, >, & and " replaced with &lt;, &gt;, &amp;
#   and &quot;.
{
  my ($amp, $ampXML);   # ampersand
  my ($quot, $quotXML); # double quote
  my ($lt, $ltXML);     # left angle bracket
  my ($gt, $gtXML);     # right angle bracket
  
  sub xmlEsc 
  {
    my ($content) = @_;
    if (!defined($content)) {
      return $content;
    }
    
    $content =~ s/$amp/$ampXML/g;
    $content =~ s/$quot/$quotXML/g;
    
    $content =~ s/$lt/$ltXML/g;
    $content =~ s/$gt/$gtXML/g;
    return $content;
  }

  BEGIN { 
    ($amp, $ampXML) = ("&", "&amp;");
    ($quot, $quotXML) = ("\"", "&quot;");
    ($lt, $ltXML) = ("<", "&lt;");
    ($gt, $gtXML) = (">", "&gt;");
  }
}

#############################################################################

# Local Variables:
# perl-indent-level: 2
# End:
